home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / Extras / Clone / opsizes.f < prev    next >
Encoding:
FORTH Source  |  1992-01-18  |  7.4 KB  |  384 lines
  1. \ OpSizes ... this file defines OPSIZE  ( opcode -- #bytes )
  2. \
  3. \ All Rights Reserved ... Mike Haas, 1987
  4.  
  5. \ MOD: MDH/PLB 8/15/89 Fixed sizes for BSET, EORI, LINK
  6. \ MOD: PLB 7/21/90 Fixed mask in +DEST
  7. \ 00001 28-nov-91 mdh      Integrated M. Kees float coprocessor support
  8.  
  9. only forth definitions
  10.  
  11. ANEW TASK-OPSIZES.f
  12.  
  13. also TGT definitions
  14.  
  15.  
  16. decimal
  17.  
  18.  
  19. : ALIT?   ( opcode-addr -- referenced-adr true / false )
  20.   dup cell- @  $ 2d07,4e71 =   \ push tos followed by nop?
  21.   IF
  22.      2+ @ true
  23.   ELSE
  24.      drop false
  25.   THEN
  26. ;
  27.  
  28.  
  29. : CALLS?  ( opcode-addr -- called-pfa true / false )
  30.   dup 2+ swap w@  dup >r
  31.   CASE
  32.     \
  33.     \ --------------------------  Origin relative?
  34.     $ 4eac OF     w@   true
  35.            ENDOF
  36.     \
  37.     \ --------------------------  +64k relative?
  38.     $ 4eab OF     w@ w->s  [ 64 1024 * ] literal +   true
  39.            ENDOF
  40.     \
  41.     \ --------------------------  LONG PC relative?
  42.     $ 6100 OF     dup w@  w->s  +    true
  43.            ENDOF
  44.     \
  45.     \ --------------------------  Absolute?
  46.     $ 4eb9 OF     @ >rel   true
  47.            ENDOF
  48.     \
  49.     \ --------------------------  SHORT PC Relative?
  50.     $ ff00 and
  51.     $ 6100 OF     r@ $ ff and b->s + true
  52.            ENDOF
  53.     \
  54.     \ NOCALL ...
  55.     2drop  false dup
  56.   ENDCASE
  57.   r> drop
  58. ;
  59.  
  60.  
  61. : ShortBRA?  ( opcode -- 0 OR offset )
  62.   dup $ 5fff >  swap $ ff and  and
  63. ;
  64.  
  65. : BRATo?  ( OpcodeAdr BranchOpcode -- DestAdr )
  66.   ShortBRA?  ?dup
  67.   IF
  68.        b->s
  69.   ELSE
  70.        dup 2+ w@ w->s
  71.   THEN
  72.   + 2+
  73. ;
  74.  
  75.  
  76. : BranchOp?  ( Opcode -- flag )
  77.   dup  $ f000 and  $ 6000 =        ( -- op flag )
  78.   over $  f00 and  $  100 -  and   ( -- op flag )
  79.   swap $ f0f8 and  $ 50c8 =  or
  80. ;
  81.  
  82.  
  83. : Branches?  ( opadr -- false / destadr true )
  84.   dup w@ BranchOp?
  85.   IF
  86.      dup w@ BRATo?  true
  87.   ELSE
  88.      drop false
  89.   THEN
  90. ;
  91.  
  92. asm PCRel?  ( opcode -- flag )
  93.         move.w    tos,d0        copy opcode
  94.         and.w    #$3e,d0        is the mode, reg field even correct?
  95.         cmp.w    #$3a,d0
  96.         bne        100$
  97. \
  98.         move.w    tos,d0        copy opcode
  99.         moveq.l    #12,d1
  100.         lsr.w    d1,d0        get hinib
  101.         cmp.w    #8,d0        greater than 7?
  102.         blt        1$
  103. \
  104.         cmp.w    #$0a,d0        yes, >7, less than 10?
  105.         blt        51$
  106.         beq        100$        ret false if equal to 10?
  107.         cmp.w    #$0e,d0
  108.         bge        100$        ret false if greater than 0d?
  109. \
  110. 51$:    btst    #8,tos        hinib == 8,9,b,c or d. bit 8 set?
  111.         bne        2$
  112.         bra        101$        ret true if bit 8==0
  113. \
  114. 2$:        move.w    tos,d0        ret true if bits 7&6==11
  115.         and.w    #$c0,d0
  116.         cmp.w    #$c0,d0
  117.         beq        101$
  118.         bra        100$
  119. \
  120. 1$:        cmp.w    #5,d0        ret false if greater than 5?
  121.         bge        100$
  122.         cmp.w    #4,d0        hinib == 0-4, is it 4?
  123.         beq        7$
  124. \
  125.         tst.w    d0            is it 0?
  126.         beq        7$
  127.         bra        101$        ret true if 1,2 or 3
  128. \
  129. 7$:        and.w    #$ffc0,tos    mask mode
  130.         cmp.w    #$0800,tos    ret true if btst static?
  131.         beq        101$
  132.         cmp.w    #$44c0,tos    ret true if move-to-ccr?
  133.         beq        101$
  134.         cmp.w    #$46c0,tos    ret true if move-to-sr?
  135.         beq        101$
  136.         cmp.w    #$4840,tos    ret true if pea?
  137.         beq        101$
  138.         cmp.w    #$4e80,tos    ret true if jsr?
  139.         beq        101$
  140.         cmp.w    #$4ec0,tos    ret true if jmp?
  141.         beq        101$
  142. \
  143.         move.w    tos,d0        copy tos
  144.         and.w    #$fe00,d0    mask bit 8
  145.         cmp.w    #$4c80,d0    ret true if movem->reg
  146.         beq        101$
  147. \
  148.         move.w    tos,d0        copy tos
  149.         and.w    #$f1c0,d0    mask bits 11,10,9
  150.         cmp.w    #$0100,d0    ret true if btst-dynamic
  151.         beq        101$
  152.         cmp.w    #$41c0,d0    ret true if lea
  153.         beq        101$
  154.         and.w    #$f140,d0    ret false if != chk?
  155.         cmp.w    #$4100,d0
  156.         bne        100$
  157. \
  158. 101$:    moveq.l    #-1,tos
  159.         bra    102$
  160. 100$:    moveq.l    #0,tos
  161. 102$:    rts
  162. end-code
  163.  
  164. : MODE>SIZE  ( op -- size , most instruction work this way )
  165.   dup >r     ( save opcode )
  166.   $ 38 and  -3 shift   ( -- opmode )
  167.   dup 5 <
  168.   IF
  169.        2    \ its either DN, AN, (AN), (AN)+, or -(AN)
  170.   ELSE
  171.        dup 7 <
  172.        IF
  173.             4   \ its either d(AN) or d(AN,?N)
  174.        ELSE
  175.             drop r@ 7 and   ( get reg# )
  176.             dup 1 =
  177.             IF
  178.                  6   ( its ABS.L )
  179.             ELSE
  180.                  dup 0=  over 2 = or  over 3 = or
  181.                  IF
  182.                       4   \ its either ABS.W, d(PC) or d(PC,?N)
  183.                  ELSE
  184.                       ( its immediate )
  185.                       r@ $ c0 and  $ c0 =
  186.                       IF
  187.                            6  ( its #LONG )
  188.                       ELSE
  189.                            4  ( its #SHORT )
  190.                       THEN
  191.                  THEN
  192.             THEN
  193.        THEN
  194.   THEN
  195.   swap r> 2drop
  196. ;
  197.  
  198.  
  199. : 0NIB  ( opcode -- size )
  200.   >r
  201.   r@ $ 38 and 8 =
  202.   IF
  203.        4  ( its MOVEP )
  204.   ELSE
  205.        r@ mode>size
  206.        r@  $ ff00 and $ 0800 =
  207.        IF
  208.             2+ ( static bit )
  209.        ELSE
  210.             r@ $ 3C and  $ 3C -   ( not immediate or SR,CCR )
  211.             r@ $ f100 and  $ 100 = 0= and ( and not dynamic bit ) 
  212.             IF
  213.                  r@ $ c0 and  -5 shift  2 max  +
  214.             THEN
  215.        THEN
  216.   THEN
  217.   r> drop
  218. ;
  219.  
  220. : +DEST  ( opcode #src+op -- #bytes-added-for-dest-operand )
  221.   swap
  222.   dup  $ 1c0 and  -3 ashift \ move mode from dest to src
  223.   swap $ E00 and  -9 ashift \ move reg from dest to src
  224.   or  mode>size 2- +
  225. ;
  226.  
  227. : 1NIB  ( opcode -- size )
  228.   dup $ ff3f and mode>size     \ calc size w/ source
  229.   +dest
  230. ;
  231.  
  232.  
  233. : 2NIB  ( opcode -- size )
  234.   dup $ 00c0 or  mode>size     \ calc size w/ source
  235.   +dest
  236. ;
  237.  
  238.  
  239. : 3NIB  ( opcode -- size )
  240.   1nib
  241. ;
  242.  
  243.  
  244. : 4NIB  ( opcode -- size )
  245.   dup $ 4afc =   ( op flag )
  246.   over $ ffC0 and  $ 4e40 =  or  ( TRAP thru RTR )
  247.   IF
  248.        dup $ FFF8 and $ 4E50 =  ( LINK ? )
  249.        IF 4
  250.        ELSE  2  \ one of specials with '4' in hinib.
  251.        THEN
  252.   ELSE
  253.        dup mode>size  over  ( op size1 op )
  254.        dup $ ff80 and dup $ 4c80 =      ( op size1 op op' flag )
  255.        swap $ 4880 =  rot $ 38 and and  ( op size1 flag flag' )  or
  256.        IF
  257.            2+  \ its MOVEM
  258.        THEN
  259.   THEN
  260.   nip
  261. ;
  262.  
  263.  
  264. : 5NIB  ( opcode -- size )
  265.   dup BranchOP?
  266.   IF
  267.      drop 4
  268.   ELSE
  269.      mode>size
  270.   THEN
  271. ;
  272.  
  273.  
  274. : 6NIB  ( opcode -- size , branches )
  275.   $ ff and
  276.   IF
  277.        2  \ SHORT BRA
  278.   ELSE
  279.        4
  280.   THEN
  281. ;
  282.  
  283.  
  284. : 7NIB  ( opcode -- size )
  285.   drop 2
  286. ;
  287.  
  288.  
  289. : ENIB  ( opcode -- size )
  290.   dup  $ c0 and $ c0 -
  291.   IF
  292.        drop 2
  293.   ELSE
  294.        mode>size
  295.   THEN
  296. ;
  297.  
  298. \ start 00001
  299.  
  300. : FNIB ( opadr opcode -- opadr size )
  301.   $ F23C =
  302.   IF
  303.      dup 2+ w@ $ 1c00 and -10 shift
  304.      CASE       \ size of immediate + 4 byte opcode
  305.         0 OF 8  \ .l long
  306.           ENDOF
  307.         1 OF 8  \ .s single
  308.           ENDOF
  309.         2 OF 16 \ .x extended
  310.           ENDOF
  311.         3 OF 16 \ .p packed d r
  312.           ENDOF
  313.         4 OF 6  \ .w word
  314.           ENDOF
  315.         5 OF 12 \ .d double
  316.           ENDOF 
  317.         6 OF 6  \ .b byte but stored as word
  318.           ENDOF
  319.         over 
  320.          ." Strange F-line instuction at $"  .hex
  321.         4 swap
  322.      ENDCASE
  323.   ELSE
  324.      4
  325.   THEN
  326. ;
  327.  
  328. \ end 00001
  329.  
  330.  
  331. : OPSIZE  ( opcode -- #bytes )
  332.   dup $ f000 and
  333.   CASE
  334.        $    0 OF   0nib  ENDOF
  335.        $ 1000 OF   1nib  ENDOF
  336.        $ 2000 OF   2nib  ENDOF
  337.        $ 3000 OF   3nib  ENDOF
  338.        $ 4000 OF   4nib  ENDOF
  339.        $ 5000 OF   5nib  ENDOF
  340.        $ 6000 OF   6nib  ENDOF
  341.        $ 7000 OF   7nib  ENDOF
  342.        $ e000 OF   enib  ENDOF
  343.        $ f000 OF   fnib  ENDOF \ MOD to allow F-line instructions 00001
  344.        drop mode>size dup
  345.   ENDCASE
  346. ;
  347.  
  348.  
  349. variable $op
  350.     
  351. : +NextOp  ( OpAdr -- #bytes )  $op off
  352.   dup >r
  353.   dup w@ OpSize over + swap  Calls?
  354.   IF
  355.        ( nextopadr pfa )
  356.        dup  ' (.")        =
  357.        over ' (")         = or
  358.        over ' ($")        = or
  359.        over ' (?warning") = or
  360.        swap ' (?abort")   = or   ( -- nextopadr flag )
  361.        IF
  362.             dup c@ 1+ even-up +  $op on
  363.        THEN
  364.   THEN
  365.   r> -
  366. ;
  367.  
  368.   
  369. : sdism  ( addr -- )
  370.   BEGIN
  371.          ?pause
  372.          dup w@ >r   ( addr )  ( -r- opcode )
  373.          dup dism-word?  2drop
  374.          r> dup $ 4e75 -
  375.   WHILE
  376.          ( addr opcode )
  377.          opsize +
  378.   REPEAT
  379.   2drop
  380. ;
  381.  
  382. only forth definitions
  383. also TGT
  384.